home *** CD-ROM | disk | FTP | other *** search
/ Action Arcade 1997 / Action Arcade 1997.iso / ps / fs.pas < prev    next >
Pascal/Delphi Source File  |  1996-12-16  |  4KB  |  126 lines
  1. unit Fs;
  2.  
  3. interface
  4.  
  5. uses SysUtils, WinTypes, WinProcs, Classes, Consts;
  6.  
  7. type
  8.   EInvalidDest = class(EStreamError);
  9.   EFCantMove = class(EStreamError);
  10.  
  11. procedure CopyFile(const FileName, DestName: TFileName);
  12. procedure MoveFile(const FileName, DestName: TFileName);
  13. function GetFileSize(const FileName: string): LongInt;
  14. function FileDateTime(const FileName: string): TDateTime;
  15. function HasAttr(const FileName: string; Attr: Word): Boolean;
  16. function ExecuteFile(const FileName, Params, DefaultDir: string;
  17.   ShowCmd: Integer): THandle;
  18.  
  19. implementation
  20.  
  21. uses Forms, ShellAPI;
  22.  
  23. const
  24.   SInvalidDest = 'Destination %s does not exist';
  25.   SFCantMove = 'Cannot move file %s';
  26.  
  27. procedure CopyFile(const FileName, DestName: TFileName);
  28. var
  29.   CopyBuffer: Pointer; { buffer for copying }
  30.   TimeStamp, BytesCopied: Longint;
  31.   Source, Dest: Integer; { handles }
  32.   Destination: TFileName; { holder for expanded destination name }
  33. const
  34.   ChunkSize: Longint = 8192; { copy in 8K chunks }
  35. begin
  36.   Destination := ExpandFileName(DestName); { expand the destination path }
  37.   if HasAttr(Destination, faDirectory) then { if destination is a directory... }
  38.     Destination := Destination + '\' + ExtractFileName(FileName); { ...clone file name }
  39.   TimeStamp := FileAge(FileName); { get source's time stamp }
  40.   GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  41.   try
  42.     Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
  43.     if Source < 0 then raise EFOpenError.Create(FmtLoadStr(SFOpenError, [FileName]));
  44.     try
  45.       Dest := FileCreate(Destination); { create output file; overwrite existing }
  46.       if Dest < 0 then raise EFCreateError.Create(FmtLoadStr(SFCreateError, [Destination]));
  47.       try
  48.         repeat
  49.           BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
  50.           if BytesCopied > 0 then { if we read anything... }
  51.             FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
  52.         until BytesCopied < ChunkSize; { until we run out of chunks }
  53.       finally
  54.         FileClose(Dest); { close the destination file }
  55. {        SetFileTimeStamp(Destination, TimeStamp);} { clone source's time stamp }{!!!}
  56.       end;
  57.     finally
  58.       FileClose(Source); { close the source file }
  59.     end;
  60.   finally
  61.     FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  62.   end;
  63. end;
  64.  
  65.  
  66. { MoveFile procedure }
  67. {
  68.   Moves the file passed in FileName to the directory specified in DestDir.
  69.   Tries to just rename the file.  If that fails, try to copy the file and
  70.   delete the original.
  71.  
  72.   Raises an exception if the source file is read-only, and therefore cannot
  73.   be deleted/moved.
  74. }
  75.  
  76. procedure MoveFile(const FileName, DestName: TFileName);
  77. var
  78.   Destination: TFileName;
  79. begin
  80.   Destination := ExpandFileName(DestName); { expand the destination path }
  81.   if not RenameFile(FileName, Destination) then { try just renaming }
  82.   begin
  83.     if HasAttr(FileName, faReadOnly) then  { if it's read-only... }
  84.       raise EFCantMove.Create(Format(SFCantMove, [FileName])); { we wouldn't be able to delete it }
  85.       CopyFile(FileName, Destination); { copy it over to destination...}
  86.       DeleteFile(FileName); { ...and delete the original }
  87.   end;
  88. end;
  89.  
  90. { GetFileSize function }
  91. {
  92.   Returns the size of the named file without opening the file.  If the file
  93.   doesn't exist, returns -1.
  94. }
  95.  
  96. function GetFileSize(const FileName: string): LongInt;
  97. var
  98.   SearchRec: TSearchRec;
  99. begin
  100.   if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
  101.     Result := SearchRec.Size
  102.   else Result := -1;
  103. end;
  104.  
  105. function FileDateTime(const FileName: string): System.TDateTime;
  106. begin
  107.   Result := FileDateToDateTime(FileAge(FileName));
  108. end;
  109.  
  110. function HasAttr(const FileName: string; Attr: Word): Boolean;
  111. begin
  112.   Result := (FileGetAttr(FileName) and Attr) = Attr;
  113. end;
  114.  
  115. function ExecuteFile(const FileName, Params, DefaultDir: string;
  116.   ShowCmd: Integer): THandle;
  117. var
  118.   zFileName, zParams, zDir: array[0..79] of Char;
  119. begin
  120.   Result := ShellExecute(Application.MainForm.Handle, nil,
  121.     StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
  122.     StrPCopy(zDir, DefaultDir), ShowCmd);
  123. end;
  124.  
  125. end.
  126.